Unit SyntaxTree;

Interface

Uses
 Classes,
 Scanner,
 SysUtils,
 TokenIterator,
 Tree;

Type
 TSyntaxTreeElement = Class;

 TSyntaxTreeElement = Class(TTreeElement)
 Private
  fToken : TToken;
 Public
  Constructor Create(T : TTokenIterator; O : TSyntaxTreeElement); Virtual;
  Property Token : TToken Read fToken;
 End;

	TSyntaxTreeIterator = Class
	Public
		Procedure Visit(Const aTarget : TSyntaxTreeElement); Virtual; Abstract;
		Function Process(Const aTarget : TSyntaxTreeElement): Boolean; Virtual; Abstract;
	End;
	
	TSyntaxTreeDownwardIterator = Class(TSyntaxTreeIterator)
	Public
		Procedure Visit(Const aTarget : TSyntaxTreeElement); Override;
	End;
	
	TSyntaxTreeUpwardIterator = Class(TSyntaxTreeIterator)
	Public
		Procedure Visit(Const aTarget : TSyntaxTreeElement); Override;
	End;	

 TStringSyntax = Class(TSyntaxTreeElement)
 Public
  Constructor Create(T : TTokenIterator; O : TSyntaxTreeElement); Override;
 End;

 TIdentifierSyntax = Class(TSyntaxTreeElement)
 Public
  Constructor Create(T : TTokenIterator; O : TSyntaxTreeElement); Override;
 End;

 TInstanceNameSyntax = Class(TIdentifierSyntax);
 TClassNameSyntax = Class(TIdentifierSyntax);

 TPropertySyntax = Class(TSyntaxTreeElement)
	Private
		fIdentifier : TIdentifierSyntax;
		fValue : TStringSyntax;
 Public
  Constructor Create(T : TTokenIterator; O : TSyntaxTreeElement); Override;
		Property Identifier : TIdentifierSyntax Read fIdentifier;
		Property Value : TStringSyntax Read fValue;
 End;

 TClassSyntax = Class(TSyntaxTreeElement)
	Private
		fInstanceName : TInstanceNameSyntax;
		fClassName : TClassNameSyntax;
 Public
  Constructor Create(T : TTokenIterator; O : TSyntaxTreeElement); Override;
		Property InstanceName : TInstanceNameSyntax Read fInstanceName;
		Property ClassKind : TClassNameSyntax Read fClassName;
 End;

 TClassFileSyntax = Class(TSyntaxTreeElement)
 Public
  Constructor Create(T : TTokenIterator; O : TSyntaxTreeElement); Override;
 End;

Procedure RaiseError(Msg : String; Tk : TToken);

Implementation

Procedure RaiseError(Msg : String; Tk : TToken);
Begin
 Raise EParser.Create(
  'Error: (' +
  Tk.SrcName + ', "' +
  Tk.Value + '", ' +
  IntToStr(Tk.Row) + ', ' +
  IntToStr(Tk.Col) + ') ' +
  Msg
  );
End;

Constructor TSyntaxTreeElement.Create(T : TTokenIterator; O : TSyntaxTreeElement);
Begin
 Inherited Create(O);
 fToken := T.Token;
	// Debug  WriteLn(Self.ClassName);
End;

Procedure TSyntaxTreeDownwardIterator.Visit(Const aTarget : TSyntaxTreeElement);
Begin
	// Debug WriteLn('Processing current node ', aTarget.ClassName, '.');
	Process(aTarget);
	If aTarget.Count > 0 Then
	Begin
		// Debug WriteLn('Iterating childs (', aTarget.Count, ').');
		aTarget.Start;
		While Not(aTarget.EOE) Do
		Begin
			Visit(aTarget.Child As TSyntaxTreeElement);
			aTarget.Next;
		End;
	End;
End;

Procedure TSyntaxTreeUpwardIterator.Visit(Const aTarget : TSyntaxTreeElement);
Begin
	If Process(aTarget) Then
		If Assigned(aTarget.Owner) Then
			Process(aTarget.Owner As TSyntaxTreeElement);
End;	

Constructor TStringSyntax.Create(T : TTokenIterator; O : TSyntaxTreeElement);
Begin
 Inherited Create(T, O);
 T.Consume(tkString, True);
End;

Constructor TIdentifierSyntax.Create(T : TTokenIterator; O : TSyntaxTreeElement);
Begin
 Inherited Create(T, O);
		If T.Expected(tkNumber, False) Then
				T.Consume(tkNumber, True)
		Else
			If T.Expected(tkIdent, True) Then
				T.Consume(tkIdent, True);
End;

Constructor TPropertySyntax.Create(T : TTokenIterator; O : TSyntaxTreeElement);
Begin
 Inherited Create(T, O);
 fIdentifier := TIdentifierSyntax.Create(T, Self);
 T.Consume(':=', True);
 fValue := TStringSyntax.Create(T, Self);
End;

Constructor TClassSyntax.Create(T : TTokenIterator; O : TSyntaxTreeElement);
Begin
 Inherited Create(T, O);
 If T.Consume('class', True) Then
 Begin
  fInstanceName := TInstanceNameSyntax.Create(T, Self);
  T.Consume('of', True);
  fClassName := TClassNameSyntax.Create(T, Self);
		If T.Consume('(', False) Then
		Begin
			If T.Expected(tkIdent, False) Then
			Begin
				AddChild(TPropertySyntax.Create(T, Self));
				While T.Consume(';', False) Do
					AddChild(TPropertySyntax.Create(T, Self));
			End;
			T.Consume(')', True);
		End;
		If T.Expected('begin', False) Then
		Begin
			T.Consume('begin', False);
			If T.Expected('class', False) Then
			Begin
				AddChild(TClassSyntax.Create(T, Self));
				While T.Consume(';', False) Do
					AddChild(TClassSyntax.Create(T, Self));
			End;
			T.Consume('end', True);
		End;
 End;
End;

Constructor TClassFileSyntax.Create(T : TTokenIterator; O : TSyntaxTreeElement);
Begin
 Inherited Create(T, O);
	Repeat
		If T.Expected('class', False) Then
			AddChild(TClassSyntax.Create(T, Self));
 Until T.Consume('.', ';');
End;

End.